Introduction

In this document, we analyze the contextualized sensorimotor norms: judgments about the strength of different sensorimotor dimensions of ambiguous words, in context.

We use these norms in several analyses:

  1. First, we compare them to the corresponding dimensions for the “decontextualized” Lancaster sensorimotor norms.
  2. Second, we ask whether the dominance of a word sense is correlated with its sensorimotor strength, i.e., whether more concrete meanings tend to be rated as more dominant.
  3. Third, we ask whether the sensorimotor distance between two contexts of use predicts judgments of how related those meanings are, above and beyond their distributional similarity and whether or not they belong to the same sense.
  4. Fourth, we use sensorimotor distance to predict behavior on a primed sensibility judgment task.

Characterizing dimensions

First, load the data.

df_contextualized_meanings = read_csv("../../data/processed/contextualized_sensorimotor_norms.csv")
## New names:
## Rows: 448 Columns: 28
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, sentence, context dbl (25): ...1, Vision.M, Vision.SD, Hearing.M,
## Hearing.SD, Olfaction.M, Olf...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
nrow(df_contextualized_meanings)
## [1] 448

Visualizing distributions

df_contextualized_meanings_long = df_contextualized_meanings %>%
  pivot_longer(cols = c(Vision.M, Hearing.M, Olfaction.M,
                        Taste.M, Interoception.M, Touch.M,
                        Mouth_throat.M, Head.M, Torso.M,
                        Hand_arm.M, Foot_leg.M),
               names_to = "Dimension",
               values_to = "Strength") %>%
  mutate(Dimension = gsub('.M', '', Dimension))

df_contextualized_meanings_long %>%
  ggplot(aes(x = reorder(Dimension, Strength),
             y = Strength)) +
  geom_violin() +
  geom_jitter(alpha = .1,
              width = .1) +
  coord_flip() +
  labs(y = "Sensorimotor strength",
       x = "Dimension") +
  theme_bw() +
  theme(text = element_text(size=20))

Correlations across dimensions

columns = df_contextualized_meanings %>%
  mutate(Vision = Vision.M,
         Hearing = Hearing.M, 
         Olfaction = Olfaction.M,
         Taste = Taste.M, 
         Interoception = Interoception.M, 
         Touch = Touch.M,
         Mouth_throat = Mouth_throat.M,
         Head = Head.M,
         Torso = Torso.M,
         Hand_arm = Hand_arm.M, 
         Foot_leg = Foot_leg.M) %>%
  select(Vision, Hearing, Olfaction,
         Taste, Interoception, Touch,
         Mouth_throat, Head, Torso,
         Hand_arm, Foot_leg)
cors = cor(columns)

# cors[lower.tri(cors, diag=TRUE)] <- 0


# Plot the correlation matrix
ggcorrplot(cors, 
           hc.order = FALSE,
           # method = "square",
           type = "upper") +
  theme(
    axis.text.x = element_text(size = 10, angle = 45, hjust = 1),
    axis.text.y = element_text(size = 10)
  )

Visualizing specific words

df_contextualized_meanings_long %>%
  group_by(word, Dimension) %>%
  mutate(Strength_scaled = scale(Strength)) %>%
  filter(word == "market") %>%
  ggplot(aes(x = reorder(Dimension, Strength_scaled),
             y = Strength_scaled,
             fill = Dimension)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  coord_flip() +
  labs(x = "Dimension",
       y = "Sensorimotor Strength (z-scored)") +
  facet_wrap(~sentence) +
  scale_fill_manual(values = viridisLite::viridis(11, option = "mako", 
                                                   begin = 0.8, end = 0.15)) + 
  theme(text = element_text(size=16)) +
  guides(fill=FALSE)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Predicting dominance

Load and merge data

Load the item-level means for the sensorimotor norms.

df_contextualized_meanings = read_csv("../../data/processed/contextualized_sensorimotor_norms_with_ls.csv")
## New names:
## Rows: 448 Columns: 30
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, sentence, context dbl (27): ...1, Unnamed: 0, Vision.M, Vision.SD,
## Hearing.M, Hearing.SD, Olfa...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
nrow(df_contextualized_meanings)
## [1] 448

Load the dominance norms.

df_dominance = read_csv("../../data/processed/dominance_norms_with_order.csv")
## New names:
## Rows: 896 Columns: 6
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, version_with_order, ambiguity_type dbl (3): ...1, dominance_right,
## sd_dominance
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
## Determine the specific sense/meaning of the righthand context
df_dominance = df_dominance %>%
  mutate(context = substr(version_with_order, 6, 9)) 

## Now group by that righthand context to get relative dominance of that meaning
df_dominance_individual = df_dominance %>%
  group_by(word, context) %>%
  summarise(dominance = mean(dominance_right))
## `summarise()` has grouped output by 'word'. You can override using the
## `.groups` argument.
nrow(df_dominance_individual)
## [1] 448

Merge the dominance and sensorimotor norms data.

df_dom_plus_sm = df_contextualized_meanings %>%
  inner_join(df_dominance_individual)
## Joining with `by = join_by(word, context)`
nrow(df_dom_plus_sm)
## [1] 448

We also load and merge the Lancaster norms, as a control.

df_lancaster = read_csv("../../data/lexical/lancaster_norms.csv")
## Rows: 39707 Columns: 45
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (6): Word, Dominant.perceptual, Dominant.action, Dominant.sensorimotor,...
## dbl (39): Auditory.mean, Gustatory.mean, Haptic.mean, Interoceptive.mean, Ol...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_lancaster = df_lancaster %>%
  mutate(word = tolower(Word)) %>%
  select(-Foot_leg.SD, -Torso.SD, -Head.SD, -Hand_arm.SD)

df_dom_plus_sm = df_dom_plus_sm %>%
  inner_join(df_lancaster)
## Joining with `by = join_by(word)`
nrow(df_dom_plus_sm)
## [1] 448

Calculating contextualized sensorimotor strength

Based on Lynott et al (2019), we contextualized sensorimotor strength as the maximum strength across all the dimensions.

df_dom_plus_sm = df_dom_plus_sm %>%
  rowwise() %>%
  mutate(max_strength = max(
    c(
      ## Modalities
      Vision.M,
      Hearing.M,
      Olfaction.M,
      Touch.M,
      Taste.M, 
      Interoception.M,
      ## Effectors
      Head.M,
      Mouth_throat.M,
      Torso.M,
      Hand_arm.M,
      Foot_leg.M
    )
  ),
  max_perceptual_strength = max(
    c(
      ## Modalities
      Vision.M,
      Hearing.M,
      Olfaction.M,
      Touch.M,
      Taste.M, 
      Interoception.M
    )
  ),
  max_action_strength = max(
    c(
      ## Effectors
      Head.M,
      Mouth_throat.M,
      Torso.M,
      Hand_arm.M,
      Foot_leg.M
    )
  )
  ) %>%
  ungroup()

df_dom_plus_sm %>%
  ggplot(aes(x = Max_strength.sensorimotor,
             y = max_strength)) +
  geom_point(alpha = .5) +
  labs(y = "Maximum Contextualized Strength",
       x = "Maximum Strength (Lancaster)") +
  theme_bw()

cor.test(df_dom_plus_sm$Max_strength.sensorimotor,
         df_dom_plus_sm$max_strength)
## 
##  Pearson's product-moment correlation
## 
## data:  df_dom_plus_sm$Max_strength.sensorimotor and df_dom_plus_sm$max_strength
## t = 10.373, df = 446, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.3630485 0.5125743
## sample estimates:
##      cor 
## 0.440865

Does contextualized sensorimotor strength predict dominance?

The answer is yes: contexts with a higher maximum sensorimotor strength also tend to be rated as more dominant.

Notably, this is true above and beyond the decontextualized ratings of sensorimotor strength for a given word.

df_dom_plus_sm %>%
  ggplot(aes(x = max_strength,
             y = dominance)) +
  geom_point(alpha = .4) +
  geom_smooth(method = "lm") +
  labs(x = "Maximum Contextualized Strength",
       y = "Dominance") +
  theme_minimal() +
  theme(text = element_text(size=16))
## `geom_smooth()` using formula = 'y ~ x'

model_full = lmer(data = df_dom_plus_sm,
                dominance ~ 
                  max_strength +
                  Max_strength.sensorimotor + Minkowski3.sensorimotor +
                  (1 | word),
                REML = FALSE)
## boundary (singular) fit: see help('isSingular')
model_reduced = lmer(data = df_dom_plus_sm,
                dominance ~ 
                  # max_strength + 
                  Max_strength.sensorimotor + Minkowski3.sensorimotor +
                  (1 | word),
                REML = FALSE)
## boundary (singular) fit: see help('isSingular')
summary(model_full)
## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
##   method [lmerModLmerTest]
## Formula: 
## dominance ~ max_strength + Max_strength.sensorimotor + Minkowski3.sensorimotor +  
##     (1 | word)
##    Data: df_dom_plus_sm
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##    1070.7    1095.3    -529.4    1058.7       442 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.30770 -0.76937 -0.01941  0.78910  2.13757 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  word     (Intercept) 0.0000   0.0000  
##  Residual             0.6221   0.7887  
## Number of obs: 448, groups:  word, 112
## 
## Fixed effects:
##                            Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                -0.47619    0.24549 448.00000  -1.940   0.0530 .  
## max_strength                0.25833    0.05964 448.00000   4.332 1.83e-05 ***
## Max_strength.sensorimotor   0.02905    0.10851 448.00000   0.268   0.7891    
## Minkowski3.sensorimotor    -0.13254    0.07421 448.00000  -1.786   0.0748 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) mx_str Mx_st.
## max_strngth -0.366              
## Mx_strngth. -0.430 -0.070       
## Mnkwsk3.sns  0.032 -0.244 -0.789
## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')
anova(model_full, model_reduced)
## Data: df_dom_plus_sm
## Models:
## model_reduced: dominance ~ Max_strength.sensorimotor + Minkowski3.sensorimotor + (1 | word)
## model_full: dominance ~ max_strength + Max_strength.sensorimotor + Minkowski3.sensorimotor + (1 | word)
##               npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)    
## model_reduced    5 1087.1 1107.6 -538.54    1077.1                         
## model_full       6 1070.7 1095.3 -529.35    1058.7 18.381  1  1.808e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
df_dom_plus_sm %>%
  mutate(resid = residuals(model_reduced)) %>%
  ggplot(aes(x = max_strength,
             y = resid)) +
  geom_point(alpha = .4) +
  geom_smooth(method = "lm") +
  labs(x = "Maximum Contextualized Strength",
       y = "Residuals (Reduced model)") +
  theme_bw()
## `geom_smooth()` using formula = 'y ~ x'

Which dimension best predicts dominance?

Here, we ask whether specific dimensions are particularly correlated with sense dominance.

features <- c("Vision.M", "Hearing.M", "Olfaction.M", "Touch.M", "Taste.M", 
              "Interoception.M", "Head.M", "Mouth_throat.M", "Torso.M", 
              "Hand_arm.M", "Foot_leg.M")

# Models with each feature + baseline covariate
r2_results <- map_dfr(features, function(feat) {
  
  formula <- as.formula(paste0("dominance ~ Max_strength.sensorimotor + ", feat))
  model <- lm(formula, data = df_dom_plus_sm)
  
  tibble(
    feature = feat,
    R2 = summary(model)$r.squared,
    beta = coef(model)[3],  # coefficient for the feature (3rd term now)
    p_value = summary(model)$coefficients[3, 4]
  )
})

# Baseline model (just Max_strength.sensorimotor)
baseline_model <- lm(dominance ~ Max_strength.sensorimotor, data = df_dom_plus_sm)

baseline_row <- tibble(
  feature = "Baseline",
  R2 = summary(baseline_model)$r.squared,
  beta = NA,
  p_value = NA
)

# Combine
r2_results_with_baseline <- bind_rows(baseline_row, r2_results)

# Plot
r2_results_with_baseline %>%
  mutate(feature = str_remove(feature, "\\.M$"),
         feature = str_replace(feature, "_", "/"),
         sig = ifelse(p_value < .05, "*", ""),
         is_baseline = feature == "Baseline",
         feature = fct_reorder(feature, R2)) %>%
  ggplot(aes(x = R2, y = feature, fill = is_baseline)) +
  geom_col() +
  geom_text(aes(label = sig), hjust = -0.5, size = 6, na.rm = TRUE) +
  scale_fill_manual(values = c("grey40", "steelblue"), guide = "none") +
  labs(x = "R²", y = NULL, title = "Predicting Sense Dominance") +
  theme_minimal() +
  theme(text = element_text(size = 16))

cor.test(df_dom_plus_sm$Touch.M,
         df_dom_plus_sm$dominance)
## 
##  Pearson's product-moment correlation
## 
## data:  df_dom_plus_sm$Touch.M and df_dom_plus_sm$dominance
## t = 3.5374, df = 446, p-value = 0.0004464
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.07368382 0.25395880
## sample estimates:
##       cor 
## 0.1652009
cor.test(df_dom_plus_sm$Vision.M,
         df_dom_plus_sm$dominance)
## 
##  Pearson's product-moment correlation
## 
## data:  df_dom_plus_sm$Vision.M and df_dom_plus_sm$dominance
## t = 4.0423, df = 446, p-value = 6.235e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.09703963 0.27583493
## sample estimates:
##       cor 
## 0.1879943

It looks like vision and touch are especially strong predictors. Which items drive this, e.g., for touch?

by_sense <- df_dom_plus_sm %>%
  mutate(sense = str_extract(context, "M[12]")) %>%
  group_by(word, sense) %>%
  summarize(
    mean_touch = mean(Touch.M),
    mean_vision = mean(Vision.M),
    mean_dom = mean(dominance),
    .groups = "drop"
  )

# Now 2 rows per word—compute within-word difference
sense_diffs <- by_sense %>%
  pivot_wider(names_from = sense, 
              values_from = c(mean_touch, mean_vision, mean_dom)) %>%
  mutate(
    touch_diff = mean_touch_M1 - mean_touch_M2,
    vision_diff = mean_vision_M1 - mean_vision_M2,
    dom_diff = mean_dom_M1 - mean_dom_M2
  )

sense_diffs %>%
  mutate(abs_touch_diff = abs(touch_diff)) %>%
  arrange(desc(abs_touch_diff)) %>%
  select(word, abs_touch_diff, dom_diff) %>%
  head(5)
## # A tibble: 5 × 3
##   word   abs_touch_diff dom_diff
##   <chr>           <dbl>    <dbl>
## 1 punch            2.87   -1.54 
## 2 spill            2.49    2.44 
## 3 racket           2.48   -1.92 
## 4 clip             2.01    0.102
## 5 case             1.99   -0.894
sense_diffs %>%
  mutate(abs_vision_diff = abs(vision_diff)) %>%
  arrange(desc(abs_vision_diff)) %>%
  select(word, abs_vision_diff, dom_diff) %>%
  head(5)
## # A tibble: 5 × 3
##   word   abs_vision_diff dom_diff
##   <chr>            <dbl>    <dbl>
## 1 break             2.02    1.30 
## 2 block             2.02    0.810
## 3 spill             1.96    2.44 
## 4 market            1.80    0.941
## 5 drain             1.73   -2.08
# Does the sense with higher Touch or Vision tend to be more dominant?
cor.test(sense_diffs$touch_diff, sense_diffs$dom_diff)
## 
##  Pearson's product-moment correlation
## 
## data:  sense_diffs$touch_diff and sense_diffs$dom_diff
## t = 2.8459, df = 110, p-value = 0.005284
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.08021574 0.42669538
## sample estimates:
##       cor 
## 0.2618737
cor.test(sense_diffs$vision_diff, sense_diffs$dom_diff)
## 
##  Pearson's product-moment correlation
## 
## data:  sense_diffs$vision_diff and sense_diffs$dom_diff
## t = 4.4908, df = 110, p-value = 1.758e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2244579 0.5397527
## sample estimates:
##       cor 
## 0.3936196

Comparing dimensions to Lancaster

Now, we compare each dimension to the LS Norms.

df_diffs = df_dom_plus_sm %>%
  mutate(vision_diff = (Vision.M - Visual.mean),
         auditory_diff = (Hearing.M - Auditory.mean),
         intero_diff = (Interoception.M - Interoceptive.mean),
         olfactory_diff = (Olfaction.M - Olfactory.mean),
         touch_diff = (Touch.M - Haptic.mean),
         taste_diff = (Taste.M - Gustatory.mean),
         torso_diff = (Torso.M - Torso.mean),
         hand_arm_diff = (Hand_arm.M - Hand_arm.mean),
         foot_leg_diff = (Foot_leg.M - Foot_leg.mean),
         head_diff = (Head.M - Head.mean),
         mouth_throat_diff = (Mouth_throat.M - Mouth.mean)) %>%
  pivot_longer(cols = c(vision_diff,
                        auditory_diff,
                        intero_diff,
                        olfactory_diff,
                        touch_diff,
                        taste_diff,
                        torso_diff,
                        hand_arm_diff,
                        foot_leg_diff,
                        head_diff,
                        mouth_throat_diff), 
               names_to = "Dimension",
               values_to = "Diff") %>%
  mutate(Dimension = gsub('_diff', '', Dimension)) %>%
  mutate(Dimension = case_when(
    Dimension == "intero" ~ "Interoception",
    Dimension == "auditory" ~ "Hearing",
    Dimension == "olfactory" ~ "Olfaction",
    TRUE ~ str_to_title(Dimension)
  ))

df_diffs$Dimension = factor(df_diffs$Dimension,
                            levels = rev(c(
                              'Vision',
                              'Hearing',
                              'Olfaction',
                              'Taste',
                              'Interoception',
                              'Touch',
                              'Mouth_throat',
                              'Head',
                              'Torso',
                              'Hand_arm',
                              'Foot_leg'
                            )))
df_diffs %>%
  filter(word == "market") %>%
  ggplot(aes(x = Dimension,
             y = Diff,
             fill = Dimension)) +
  geom_bar(stat = "summary") + 
  geom_vline(xintercept = 0, linetype = "dotted") +
  theme_bw() +
  coord_flip() +
  labs(x = "Dimension",
       y = "Deviation from Lancaster Norms") +
  scale_fill_manual(values = viridisLite::viridis(11, option = "mako", 
                                                   begin = 0.8, end = 0.15)) + 
  facet_wrap(~sentence) +
  theme(text = element_text(size=16)) +
  guides(fill = FALSE)
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`

We also look at this across all words:

df_diffs %>%
  ggplot(aes(x = reorder(Dimension, Diff),
             y = Diff)) +
  geom_violin() +
  geom_jitter(alpha = .1,
              width = .1) +
  geom_hline(yintercept = 0, linetype = "dotted") +
  theme_bw() +
  coord_flip() +
  labs(x = "Dimension",
       y = "Deviation from Lancaster Norms") +
  theme(text = element_text(size=16))

How does dominance relate to deviation from the LS Norms?

This question can in turn be decomposed into two questions:

First, are more dominant senses closer to the LS Norms overall? We might expect this to be the case if the LS Norms reflect the dominant sense; that is, when people rate the sensorimotor properties of a decontextualized word, they might be more likely to index properties associated with the most dominant contexts or meanings of that word.

And the answer is yes: more dominant senses are indeed more similar (less distant) from the Lancaster norm in terms of their sensorimotor profile.

model_with_dominance = lmer(data = df_dom_plus_sm,
                  distance_to_lancaster ~ dominance + (1 | word),
                  REML = FALSE)

model_no_dominance = lmer(data = df_dom_plus_sm,
                  distance_to_lancaster ~ (1 | word),
                  REML = FALSE)

summary(model_with_dominance)
## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
##   method [lmerModLmerTest]
## Formula: distance_to_lancaster ~ dominance + (1 | word)
##    Data: df_dom_plus_sm
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##   -1305.6   -1289.2     656.8   -1313.6       444 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.8511 -0.5791 -0.2326  0.4193  4.0935 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  word     (Intercept) 0.000806 0.02839 
##  Residual             0.002542 0.05042 
## Number of obs: 448, groups:  word, 112
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)   0.077717   0.003605 114.138534   21.56  < 2e-16 ***
## dominance    -0.009957   0.002981 344.678498   -3.34 0.000929 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr)
## dominance 0.099
anova(model_with_dominance, model_no_dominance)
## Data: df_dom_plus_sm
## Models:
## model_no_dominance: distance_to_lancaster ~ (1 | word)
## model_with_dominance: distance_to_lancaster ~ dominance + (1 | word)
##                      npar     AIC     BIC logLik -2*log(L)  Chisq Df Pr(>Chisq)
## model_no_dominance      3 -1296.7 -1284.4 651.35   -1302.7                     
## model_with_dominance    4 -1305.6 -1289.2 656.82   -1313.6 10.934  1  0.0009444
##                         
## model_no_dominance      
## model_with_dominance ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
df_dom_plus_sm %>%
  ggplot(aes(x = dominance,
             y = distance_to_lancaster)) +
  geom_point(alpha = .5) +
  geom_smooth(method = "lm") +
  labs(x = "Dominance",
       y = "Cosine Distance to Decontextualized LS Norm") +
  theme_bw()
## `geom_smooth()` using formula = 'y ~ x'

cor.test(df_dom_plus_sm$dominance, df_dom_plus_sm$distance_to_lancaster)
## 
##  Pearson's product-moment correlation
## 
## data:  df_dom_plus_sm$dominance and df_dom_plus_sm$distance_to_lancaster
## t = -2.7295, df = 446, p-value = 0.006594
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.21823310 -0.03596218
## sample estimates:
##        cor 
## -0.1281799

And second: does dominance predict the direction of difference?

The earlier analysis of dominance suggests that more dominant senses are more concrete than less dominant senses. Thus, we might expect that more dominant senses are also more concrete on average than the decontextualized norms.

We find that this is true: that is, more dominant senses are more concrete on average than the LS norm.

df_diffs_avg = df_diffs %>%
  group_by(word, sentence, context) %>%
  summarise(mean_diff = mean(Diff))
## `summarise()` has grouped output by 'word', 'sentence'. You can override using
## the `.groups` argument.
df_diffs_avg = df_diffs_avg %>%
  left_join(df_dom_plus_sm)
## Joining with `by = join_by(word, sentence, context)`
model_with_dominance = lmer(data = df_diffs_avg,
                  mean_diff ~ dominance + (1 | word),
                  REML = FALSE)

model_no_dominance = lmer(data = df_diffs_avg,
                  mean_diff ~ (1 | word),
                  REML = FALSE)

summary(model_with_dominance)
## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
##   method [lmerModLmerTest]
## Formula: mean_diff ~ dominance + (1 | word)
##    Data: df_diffs_avg
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##     114.1     130.5     -53.1     106.1       444 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8348 -0.5528 -0.0351  0.5782  2.8769 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  word     (Intercept) 0.04174  0.2043  
##  Residual             0.05175  0.2275  
## Number of obs: 448, groups:  word, 112
## 
## Fixed effects:
##              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept) 9.659e-03  2.216e-02 1.132e+02   0.436    0.664    
## dominance   8.583e-02  1.349e-02 3.407e+02   6.361 6.44e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr)
## dominance 0.073
anova(model_with_dominance, model_no_dominance)
## Data: df_diffs_avg
## Models:
## model_no_dominance: mean_diff ~ (1 | word)
## model_with_dominance: mean_diff ~ dominance + (1 | word)
##                      npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)
## model_no_dominance      3 150.36 162.67 -72.179    144.36                     
## model_with_dominance    4 114.12 130.54 -53.062    106.12 38.235  1  6.271e-10
##                         
## model_no_dominance      
## model_with_dominance ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cor.test(df_diffs_avg$dominance, df_diffs_avg$mean_diff)
## 
##  Pearson's product-moment correlation
## 
## data:  df_diffs_avg$dominance and df_diffs_avg$mean_diff
## t = 4.7696, df = 446, p-value = 2.504e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1303131 0.3066838
## sample estimates:
##       cor 
## 0.2202983

Predicting relatedness

Next, we ask about the sensorimotor distance between two sentence pairs, and whether it correlates both with same/different sense and the mean_relatedness judgments for those sentence pairs.

Here, we load a version of the dataset that also contains a baseline measure: the sensorimotor distance as calculated using a bag-of-words approach (i.e., using the original Lancaster Norms).

Load data

df_rawc_with_norms = read_csv("../../data/processed/sentence_pairs_with_sensorimotor_distance.csv") %>%
  drop_na(sensorimotor_distance) %>%
  select(sensorimotor_distance, action_distance, perceptual_distance,
         word, same, ambiguity_type, sentence1, sentence2, mean_relatedness, Class)
## Rows: 672 Columns: 22
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): word, sentence1, sentence2, ambiguity_type, disambiguating_word1, ...
## dbl (11): mean_relatedness, median_relatedness, diff, count, sd_relatedness,...
## lgl  (1): same
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
nrow(df_rawc_with_norms)
## [1] 672

Load English RAW-C data

df_bert = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-uncased.csv") %>%
  mutate(Model = "BERT-base-uncased",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_bert_cased = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-cased.csv") %>%
  mutate(Model = "BERT-base-cased",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_xlm = read_csv("../../data/processed/models_english/rawc-distances_model-xlm-roberta-base.csv") %>%
  mutate(Model = "XLM-RoBERTa",
         Multilingual = "Multilingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_ab1 = read_csv("../../data/processed/models_english/rawc-distances_model-albert-base-v1.csv") %>%
  mutate(Model = "ALBERT-base-v1",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_ab2 = read_csv("../../data/processed/models_english/rawc-distances_model-albert-base-v2.csv") %>%
  mutate(Model = "ALBERT-base-v2",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_al = read_csv("../../data/processed/models_english/rawc-distances_model-albert-large-v2.csv") %>%
  mutate(Model = "ALBERT-large-v2",
         Multilingual = "Monolingual")
## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_axl = read_csv("../../data/processed/models_english/rawc-distances_model-albert-xlarge-v2.csv") %>%
  mutate(Model = "ALBERT-xlarge-v2",
         Multilingual = "Monolingual")
## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_axxl = read_csv("../../data/processed/models_english/rawc-distances_model-albert-xxlarge-v2.csv")  %>%
  mutate(Model = "ALBERT-xxlarge-v2",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_rb = read_csv("../../data/processed/models_english/rawc-distances_model-roberta-base.csv") %>%
  mutate(Model = "RoBERTa-base",
         Multilingual = "Monolingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_rl = read_csv("../../data/processed/models_english/rawc-distances_model-roberta-large.csv") %>%
  mutate(Model = "RoBERTa-large",
         Multilingual = "Monolingual")
## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_db = read_csv("../../data/processed/models_english/rawc-distances_model-distilbert-base-uncased.csv") %>%
  mutate(Model = "DistilBERT",
         Multilingual = "Monolingual")
## Rows: 4704 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_mb = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-multilingual-cased.csv") %>%
  mutate(Model = "Multilingual BERT",
         Multilingual = "Multilingual")
## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
df_all = df_bert %>%
  bind_rows(df_bert_cased) %>%
  bind_rows(df_xlm) %>%
  bind_rows(df_ab1) %>%
  bind_rows(df_ab2) %>%
  bind_rows(df_al) %>%
  bind_rows(df_axl) %>%
  bind_rows(df_axxl) %>%
  bind_rows(df_rb) %>%
  bind_rows(df_rl) %>%
  bind_rows(df_db) %>%
  bind_rows(df_mb)


df_merged = df_rawc_with_norms %>%
  inner_join(df_all)
## Joining with `by = join_by(word, sentence1, sentence2)`

Predicting same/different sense

Sensorimotor distance and sense boundaries

df_rawc_with_norms = df_rawc_with_norms %>%
  mutate(Same = case_when(
    same == TRUE ~ "Same Sense",
    same == FALSE ~ "Different Sense"
  ))



df_rawc_with_norms %>%
  ggplot(aes(x = sensorimotor_distance,
             y = ambiguity_type,
             fill = Same)) +
  geom_density_ridges2(aes(height = ..density..), 
                       color = NA,
                       alpha = 0.5, 
                       scale=0.85, 
                       stat="density") +
  labs(x = "Sensorimotor Distance",
       y = NULL,
       fill = NULL) +
  scale_fill_manual(
    values = c("Same Sense" = viridisLite::viridis(2, option = "mako", begin = 0.8, end = 0.15)[1],
               "Different Sense" = viridisLite::viridis(2, option = "mako", begin = 0.8, end = 0.15)[2])
  ) + 
  theme_minimal() +
  theme(text = element_text(size = 20))
## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

model_full = lmer(data = df_rawc_with_norms,
                  sensorimotor_distance ~ same +
                    (1 + same | word),
                  control=lmerControl(optimizer="bobyqa"),
                  REML = FALSE)
## boundary (singular) fit: see help('isSingular')
model_reduced = lmer(data = df_rawc_with_norms,
                  sensorimotor_distance ~ # same +
                    (1 + same | word),
                  control=lmerControl(optimizer="bobyqa"),
                  REML = FALSE)
## boundary (singular) fit: see help('isSingular')
summary(model_full)
## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
##   method [lmerModLmerTest]
## Formula: sensorimotor_distance ~ same + (1 + same | word)
##    Data: df_rawc_with_norms
## Control: lmerControl(optimizer = "bobyqa")
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##   -2203.5   -2176.4    1107.7   -2215.5       666 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.0011 -0.5738 -0.1294  0.4572  3.7891 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  word     (Intercept) 0.003693 0.06077       
##           sameTRUE    0.002874 0.05361  -1.00
##  Residual             0.001447 0.03803       
## Number of obs: 672, groups:  word, 112
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)   0.100224   0.006017 112.005213  16.658   <2e-16 ***
## sameTRUE     -0.057033   0.005946 117.316950  -9.592   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##          (Intr)
## sameTRUE -0.903
## optimizer (bobyqa) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')
anova(model_full, model_reduced)
## Data: df_rawc_with_norms
## Models:
## model_reduced: sensorimotor_distance ~ (1 + same | word)
## model_full: sensorimotor_distance ~ same + (1 + same | word)
##               npar     AIC     BIC logLik -2*log(L)  Chisq Df Pr(>Chisq)    
## model_reduced    5 -2137.8 -2115.3 1073.9   -2147.8                         
## model_full       6 -2203.5 -2176.4 1107.7   -2215.5 67.654  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Predicting sense boundaries

Here, we run the actual analysis:

model_sm_only <- glm(same ~ sensorimotor_distance, 
                     data = df_rawc_with_norms, 
                     family = binomial)


aic_sm_baseline <- AIC(model_sm_only)

print(paste("AIC:", round(aic_sm_baseline, 1)))
## [1] "AIC: 707.3"
### Get aic
aic_results <- df_merged %>%
  group_by(n_params, Model, Layer) %>%
  summarize(
    # BERT only
    aic_bert = {
      model <- glm(Same_sense ~ Distance, family = binomial)
      AIC(model)
    },
    # Combined
    aic_combined = {
      model <- glm(Same_sense ~ Distance + sensorimotor_distance, family = binomial)
      AIC(model)
    },
    aic_sm = {
      model <- glm(Same_sense ~ sensorimotor_distance, family = binomial)
      AIC(model)
    },
    .groups = "drop"
  ) %>%
  mutate(
    # AIC Delta
    aic_bert_vs_sm = aic_bert - aic_sm_baseline,
    aic_combined_vs_sm = aic_sm_baseline - aic_combined,
    aic_combined_vs_dist = aic_bert - aic_combined
  )

# ============================================================
# 3. Best layer per model
# ============================================================

best_layers <- aic_results %>%
  group_by(Model, n_params) %>%
  slice_min(aic_bert, n = 1) %>%
  select(Model, Layer, 
         aic_bert_vs_sm, aic_combined_vs_sm, aic_combined_vs_dist,
          aic_sm, aic_bert, aic_combined)
## Adding missing grouping variables: `n_params`
best_layers = best_layers %>%
  mutate(aic_bert_vs_sm2 = aic_bert - aic_sm_baseline)

print(best_layers)
## # A tibble: 12 × 10
## # Groups:   Model, n_params [12]
##     n_params Model  Layer aic_bert_vs_sm aic_combined_vs_sm aic_combined_vs_dist
##        <dbl> <chr>  <dbl>          <dbl>              <dbl>                <dbl>
##  1  11683584 ALBER…     8           29.8               80.3                110. 
##  2  11683584 ALBER…    12          -80.9              144.                  62.8
##  3  17683968 ALBER…     9          -38.1              115.                  76.8
##  4  58724864 ALBER…    13         -165.               201.                  36.3
##  5 222595584 ALBER…     7         -250.               279.                  28.5
##  6 108310272 BERT-…    12         -117.               169.                  52.2
##  7 109482240 BERT-…    12         -176.               214.                  37.3
##  8  66362880 Disti…     6         -104.               153.                  49.3
##  9 177853440 Multi…     8           34.3               75.0                109. 
## 10 124645632 RoBER…     8         -138.               194.                  55.9
## 11 355359744 RoBER…    16         -256.               273.                  17.1
## 12 278043648 XLM-R…     6          103.                18.3                121. 
## # ℹ 4 more variables: aic_sm <dbl>, aic_bert <dbl>, aic_combined <dbl>,
## #   aic_bert_vs_sm2 <dbl>
## AIC difference from SM baseline

best_layers %>%
  select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
  pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
               names_to = "type", values_to = "aic_diff") %>%
  mutate(type = ifelse(type == "aic_bert_vs_sm", 
                       "Distributional only", 
                       "Distributional + Sensorimotor"),
         type = factor(type, levels = c("Distributional only", 
                                        "Distributional + Sensorimotor")),
         Model = fct_reorder(Model, aic_diff)) %>%
  ggplot(aes(x = aic_diff, y = Model, fill = type)) +
  geom_col(position = "dodge") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
  labs(x = "ΔAIC vs. Sensorimotor baseline", 
       y = NULL,
       fill = NULL) +
  scale_fill_manual(values = c("Distributional only" = "gray60", 
                                "Distributional + Sensorimotor" = "steelblue")) +
  theme_minimal() +
  theme(text = element_text(size = 16),
        legend.position = "bottom")
## Adding missing grouping variables: `n_params`

best_layers %>%
  select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
  pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
               names_to = "type", values_to = "aic_diff") %>%
  mutate(type = ifelse(type == "aic_bert_vs_sm", 
                       "Distributional only", 
                       "Distributional + Sensorimotor"),
         type = factor(type, levels = c("Distributional only", 
                                        "Distributional + Sensorimotor")),
         Model = fct_reorder(Model, aic_diff)) %>%
  ggplot(aes(x = n_params,
             y = aic_diff,
             color = type)) +
  geom_point(size = 6,
             alpha = .7) +
  scale_x_log10() +
  geom_hline(yintercept = 0, linetype = "dotted", color = "black") +
  labs(x = "Parameters",
       y = "ΔAIC vs. Sensorimotor baseline",
       color = "",
       title = "Predicting Sense Boundaries") +
  scale_color_manual(values = c("Distributional only" = "gray60", 
                                "Distributional + Sensorimotor" = "steelblue")) +
  theme_minimal() +
  # guides(color="none") +
  theme(text = element_text(size = 15),
        legend.position="bottom")
## Adding missing grouping variables: `n_params`

aic_results %>%
  mutate(dist_better_than_sm = aic_bert_vs_sm > 4,
         hybrid_better_than_sm = aic_combined_vs_sm > 4,
         hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
  summarise(mean(dist_better_than_sm),
            mean(hybrid_better_than_sm),
            mean(hybrid_better_than_dist))
## # A tibble: 1 × 3
##   `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
##                         <dbl>                       <dbl>                  <dbl>
## 1                       0.414                       0.925                      1
## # ℹ abbreviated names: ¹​`mean(hybrid_better_than_sm)`,
## #   ²​`mean(hybrid_better_than_dist)`
best_layers %>%
  ungroup() %>%
  mutate(dist_better_than_sm = aic_bert_vs_sm < -4,
         hybrid_better_than_sm = aic_combined_vs_sm > 4,
         hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
  summarise(mean(dist_better_than_sm),
            mean(hybrid_better_than_sm),
            mean(hybrid_better_than_dist))
## # A tibble: 1 × 3
##   `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
##                         <dbl>                       <dbl>                  <dbl>
## 1                        0.75                           1                      1
## # ℹ abbreviated names: ¹​`mean(hybrid_better_than_sm)`,
## #   ²​`mean(hybrid_better_than_dist)`
### Visualize raw AIC
aic_summary_full <- best_layers %>%
  select(Model, Layer, aic_sm, aic_bert, aic_combined) %>%
  pivot_longer(cols = c(aic_sm, aic_bert, aic_combined),
               names_to = "type", values_to = "aic") %>%
  mutate(type = case_when(
    type == "aic_sm" ~ "Sensorimotor",
    type == "aic_bert" ~ "Distributional",
    type == "aic_combined" ~ "Hybrid"
  ),
  type = factor(type, levels = c("Sensorimotor", "Distributional", "Hybrid")))
## Adding missing grouping variables: `n_params`
# Get sensorimotor baseline (should be the same for all models)
aic_sm_baseline <- aic_summary_full %>%
  filter(type == "Sensorimotor") %>%
  pull(aic) %>%
  unique()

# Filter to just distributional and hybrid
aic_summary_no_sm <- aic_summary_full %>%
  filter(type != "Sensorimotor")

aic_summary_se_no_sm <- aic_summary_no_sm %>%
  group_by(type) %>%
  summarize(
    mean_aic = mean(aic),
    se_aic = sd(aic) / sqrt(n())
  )

ggplot() +
  # Sensorimotor baseline as dashed line
  geom_hline(yintercept = aic_sm_baseline, 
             linetype = "dashed", color = "coral", linewidth = 1) +
  # Raw points for each model/layer
  geom_jitter(data = aic_summary_no_sm, 
              aes(x = type, y = aic, color = type),
              alpha = 0.3, width = 0.1, size = 2) +
  # Mean + SE
  geom_point(data = aic_summary_se_no_sm, 
             aes(x = type, y = mean_aic, color = type),
             size = 5) +
  geom_errorbar(data = aic_summary_se_no_sm, 
                aes(x = type, ymin = mean_aic - se_aic, 
                    ymax = mean_aic + se_aic, color = type), 
                width = 0.15, linewidth = 1.2) +
  annotate("text", x = 1.5, y = aic_sm_baseline + 30, 
           label = "Sensorimotor", color = "coral", size = 5)+
  labs(x = NULL, 
       y = "AIC (lower is better)",
       title = "Predicting Sense Boundary") +
  scale_color_manual(values = c("Distributional" = "gray60", 
                                "Hybrid" = "steelblue")) +
  theme_minimal() +
  theme(text = element_text(size = 16),
        legend.position = "none")

Predicting relatedness

Comparing to each distributional relatedness measure

df_rawc_with_norms %>%
  ggplot(aes(x = sensorimotor_distance,
            y = mean_relatedness,
            color = Same)) +
  geom_point(alpha = .5) +
  scale_color_manual(
    values = c("Same Sense" = viridisLite::viridis(2, option = "mako", 
                                                   begin = 0.8, end = 0.15)[1],
               "Different Sense" = viridisLite::viridis(2, option = "mako", 
                                                        begin = 0.8, end = 0.15)[2])
  ) +
  theme_minimal() +
  labs(x = "Sensorimotor Distance",
       y = "Mean Relatedness",
       color = "") +
  theme(text = element_text(size = 15),
      legend.position="bottom")

cor(df_rawc_with_norms$sensorimotor_distance,
            df_rawc_with_norms$mean_relatedness)
## [1] -0.5346106

Comparing AIC

# ============================================================
# 1. Sensorimotor only (baseline)
# ============================================================

model_sm_only <- lm(mean_relatedness ~ sensorimotor_distance, 
                    data = df_merged)

r2_sm_baseline <- summary(model_sm_only)$r.squared
aic_sm_baseline <- AIC(model_sm_only)

print(paste("Sensorimotor baseline - R²:", round(r2_sm_baseline, 3), "AIC:", round(aic_sm_baseline, 1)))
## [1] "Sensorimotor baseline - R²: 0.286 AIC: 395959.1"
# ============================================================
# 2. For each model/layer: compute R² and AIC, difference from SM baseline
# ============================================================

relatedness_results <- df_merged %>%
  group_by(Model, Layer, n_params, Multilingual) %>%
  summarize(
    # Sensorimotor only
    r2_sm = {
      model <- lm(mean_relatedness ~ sensorimotor_distance)
      summary(model)$r.squared
    },
    aic_sm = {
      model <- lm(mean_relatedness ~ sensorimotor_distance)
      AIC(model)
    },
    # BERT only
    r2_bert = {
      model <- lm(mean_relatedness ~ Distance)
      summary(model)$r.squared
    },
    aic_bert = {
      model <- lm(mean_relatedness ~ Distance)
      AIC(model)
    },
    # Combined
    r2_combined = {
      model <- lm(mean_relatedness ~ Distance + sensorimotor_distance)
      summary(model)$r.squared
    },
    aic_combined = {
      model <- lm(mean_relatedness ~ Distance + sensorimotor_distance)
      AIC(model)
    },
    .groups = "drop"
  ) %>%
  mutate(
    aic_bert_vs_sm = aic_bert - aic_sm,
    aic_combined_vs_sm = aic_sm - aic_combined,
    aic_combined_vs_dist = aic_bert - aic_combined
  )

# ============================================================
# 3. Best layer per model
# ============================================================

best_layers <- relatedness_results %>%
  group_by(Model, n_params, Multilingual) %>%
  slice_max(r2_bert, n = 1) %>%
  select(Model, Layer, n_params, Multilingual,
         # r2_sm, r2_bert, r2_combined,
         aic_bert_vs_sm, aic_sm, aic_bert, aic_combined,
         aic_combined_vs_sm, aic_combined_vs_dist)

print(best_layers)
## # A tibble: 12 × 10
## # Groups:   Model, n_params, Multilingual [12]
##    Model Layer n_params Multilingual aic_bert_vs_sm aic_sm aic_bert aic_combined
##    <chr> <dbl>    <dbl> <chr>                 <dbl>  <dbl>    <dbl>        <dbl>
##  1 ALBE…     9   1.17e7 Monolingual          111.    2135.    2246.        2053.
##  2 ALBE…    12   1.17e7 Monolingual            4.57  2135.    2139.        1997.
##  3 ALBE…    14   1.77e7 Monolingual            7.41  2135.    2142.        2002.
##  4 ALBE…    15   5.87e7 Monolingual         -140.    2135.    1995.        1878.
##  5 ALBE…     8   2.23e8 Monolingual         -234.    2135.    1901.        1790.
##  6 BERT…    12   1.08e8 Monolingual          -96.8   2135.    2038.        1911.
##  7 BERT…    12   1.09e8 Monolingual         -175.    2135.    1960.        1855.
##  8 Dist…     6   6.64e7 Monolingual          -79.2   2135.    2056.        1937.
##  9 Mult…    12   1.78e8 Multilingual          90.7   2135.    2225.        2062.
## 10 RoBE…    11   1.25e8 Monolingual         -117.    2135.    2018.        1899.
## 11 RoBE…    22   3.55e8 Monolingual         -291.    2135.    1844.        1759.
## 12 XLM-…     9   2.78e8 Multilingual         143.    2135.    2277.        2088.
## # ℹ 2 more variables: aic_combined_vs_sm <dbl>, aic_combined_vs_dist <dbl>
best_layers %>%
  select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
  pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
               names_to = "type", values_to = "aic_diff") %>%
  mutate(type = ifelse(type == "aic_bert_vs_sm", "Distributional only", "Distributional + Sensorimotor"),
         type = factor(type, levels = c("Distributional only", "Distributional + Sensorimotor")),
         Model = fct_reorder(Model, aic_diff)) %>%
  ggplot(aes(x = aic_diff, y = Model, fill = type)) +
  geom_col(position = "dodge") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
  geom_vline(xintercept = 4, linetype = "dotted", color = "gray50") +
  geom_vline(xintercept = -4, linetype = "dotted", color = "gray50") +
  labs(x = "ΔAIC vs. Sensorimotor baseline", 
       y = NULL,
       fill = NULL) +
  scale_fill_manual(values = c("Distributional only" = "gray60", 
                                "Distributional + Sensorimotor" = "steelblue")) +
  theme_minimal() +
  theme(text = element_text(size = 16),
        legend.position = "bottom")
## Adding missing grouping variables: `n_params`, `Multilingual`

# ============================================================
# 7. Summary
# ============================================================

best_layers %>%
  ungroup() %>%
  mutate(dist_better_than_sm = aic_bert_vs_sm < -4,
         hybrid_better_than_sm = aic_combined_vs_sm > 4,
         hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
  summarise(mean(dist_better_than_sm),
            mean(hybrid_better_than_sm),
            mean(hybrid_better_than_dist))
## # A tibble: 1 × 3
##   `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
##                         <dbl>                       <dbl>                  <dbl>
## 1                       0.583                           1                      1
## # ℹ abbreviated names: ¹​`mean(hybrid_better_than_sm)`,
## #   ²​`mean(hybrid_better_than_dist)`
### Visualize raw AIC
aic_summary_full <- best_layers %>%
  select(Model, Layer, aic_sm, aic_bert, aic_combined) %>%
  pivot_longer(cols = c(aic_sm, aic_bert, aic_combined),
               names_to = "type", values_to = "aic") %>%
  mutate(type = case_when(
    type == "aic_sm" ~ "Sensorimotor",
    type == "aic_bert" ~ "Distributional",
    type == "aic_combined" ~ "Hybrid"
  ),
  type = factor(type, levels = c("Sensorimotor", "Distributional", "Hybrid")))
## Adding missing grouping variables: `n_params`, `Multilingual`
# Get sensorimotor baseline (should be the same for all models)
aic_sm_baseline <- aic_summary_full %>%
  filter(type == "Sensorimotor") %>%
  pull(aic) %>%
  unique()

# Filter to just distributional and hybrid
aic_summary_no_sm <- aic_summary_full %>%
  filter(type != "Sensorimotor")

aic_summary_se_no_sm <- aic_summary_no_sm %>%
  group_by(type) %>%
  summarize(
    mean_aic = mean(aic),
    se_aic = sd(aic) / sqrt(n())
  )

ggplot() +
  # Sensorimotor baseline as dashed line
  geom_hline(yintercept = aic_sm_baseline, 
             linetype = "dashed", color = "coral", linewidth = 1) +
  # Raw points for each model/layer
  geom_jitter(data = aic_summary_no_sm, 
              aes(x = type, y = aic, color = type),
              alpha = 0.3, width = 0.1, size = 2) +
  # Mean + SE
  geom_point(data = aic_summary_se_no_sm, 
             aes(x = type, y = mean_aic, color = type),
             size = 5) +
  geom_errorbar(data = aic_summary_se_no_sm, 
                aes(x = type, ymin = mean_aic - se_aic, 
                    ymax = mean_aic + se_aic, color = type), 
                width = 0.15, linewidth = 1.2) +
  annotate("text", x = 1.5, y = aic_sm_baseline + 30, 
           label = "Sensorimotor", color = "coral", size = 5)+
  labs(x = NULL, 
       y = "AIC (lower is better)",
       title = "Predicting Relatedness") +
  scale_color_manual(values = c("Distributional" = "gray60", 
                                "Hybrid" = "steelblue")) +
  theme_minimal() +
  theme(text = element_text(size = 16),
        legend.position = "none")

Correlation between sensorimotor and distributional distance

# Get best layer
df_by_layer = df_merged %>%
  group_by(Model, Multilingual, Layer, n_params) %>%
  summarise(r = cor(mean_relatedness, Distance, method = "pearson"),
            r2 = r ** 2,
            rho = cor(mean_relatedness, Distance, method = "spearman"),
            count = n())
## `summarise()` has grouped output by 'Model', 'Multilingual', 'Layer'. You can
## override using the `.groups` argument.
df_best_layer <- df_by_layer %>%
  group_by(Model) %>%
  slice_max(r2, n = 1) %>%
  select(Model, Layer, r2)

# Filter for only best layers
df_best <- df_merged %>%
  semi_join(df_best_layer, by = c("Model", "Layer"))

# Pivot wider
df_wide <- df_best %>%
  mutate(`Sensorimotor Distance` = sensorimotor_distance) %>%
  select(word, sentence1, sentence2, `Sensorimotor Distance`, Model, Distance) %>%
  pivot_wider(names_from = Model, values_from = Distance)

# Compute correlation matrix
cor_matrix <- df_wide %>%
  select(`Sensorimotor Distance`, where(is.numeric)) %>%
  cor(use = "pairwise.complete.obs")

# Plot the correlation matrix
ggcorrplot(cor_matrix, 
           hc.order = FALSE,
           method = "square") +
  theme(
    axis.text.x = element_text(size = 10, angle = 45, hjust = 1),
    axis.text.y = element_text(size = 10)
  )

Baseline with LS Norms

df_with_baseline = read_csv("../../data/processed/sentence_pairs_with_baseline.csv") %>%
  drop_na(sensorimotor_distance) %>%
  drop_na(baseline_distance)
## Rows: 672 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): word, sentence1, sentence2, ambiguity_type, disambiguating_word1, ...
## dbl (12): mean_relatedness, median_relatedness, diff, count, sd_relatedness,...
## lgl  (1): same
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
nrow(df_with_baseline)
## [1] 576

Does sensorimotor distance predict relatedness above the baseline?

We also ask whether whether our measure of contextualized sensorimotor distance predicts relatedness above and beyond a baseline that simply considers the decontextualized Lancaster Sensorimotor Norms for the dismabiguating words in a sentence. (We find that it does.)

model_bow_sm  = lmer(data = df_with_baseline,
                mean_relatedness ~ baseline_distance + sensorimotor_distance +
                  (1| word),
                REML = FALSE)

model_just_bow  = lmer(data = df_with_baseline,
                mean_relatedness ~ baseline_distance + 
                  (1| word),
                REML = FALSE)

model_just_sm  = lmer(data = df_with_baseline,
                mean_relatedness ~ sensorimotor_distance + 
                  (1| word),
                REML = FALSE)

summary(model_bow_sm)
## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
##   method [lmerModLmerTest]
## Formula: mean_relatedness ~ baseline_distance + sensorimotor_distance +  
##     (1 | word)
##    Data: df_with_baseline
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##    1769.7    1791.4    -879.8    1759.7       571 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.25085 -0.78889 -0.03104  0.72182  2.32643 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  word     (Intercept) 0.3784   0.6152  
##  Residual             1.0144   1.0072  
## Number of obs: 576, groups:  word, 111
## 
## Fixed effects:
##                       Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)             3.2956     0.1052 275.9319  31.318  < 2e-16 ***
## baseline_distance      -2.2025     0.4063 574.4962  -5.421 8.73e-08 ***
## sensorimotor_distance -10.3560     0.8134 562.8948 -12.731  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) bsln_d
## basln_dstnc -0.455       
## snsrmtr_dst -0.322 -0.411
anova(model_bow_sm, model_just_bow)
## Data: df_with_baseline
## Models:
## model_just_bow: mean_relatedness ~ baseline_distance + (1 | word)
## model_bow_sm: mean_relatedness ~ baseline_distance + sensorimotor_distance + (1 | word)
##                npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)    
## model_just_bow    4 1909.7 1927.2 -950.86    1901.7                         
## model_bow_sm      5 1769.7 1791.4 -879.83    1759.7 142.07  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
anova(model_bow_sm, model_just_sm)
## Data: df_with_baseline
## Models:
## model_just_sm: mean_relatedness ~ sensorimotor_distance + (1 | word)
## model_bow_sm: mean_relatedness ~ baseline_distance + sensorimotor_distance + (1 | word)
##               npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)    
## model_just_sm    4 1795.5 1813.0 -893.77    1787.5                         
## model_bow_sm     5 1769.7 1791.4 -879.83    1759.7 27.881  1   1.29e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1